Nothing but Tetris

home *** CD-ROM | disk | FTP | other *** search

/ Nothing but Tetris / Nothing but Tetris.iso / amiga / shapes / autoexec.amos / autoexec.amosSourceCode next >

Wrap

AMOS Source Code | 1991-05-17 | 24.9 KB | 885 lines

Dim HIGH_NAME$(10),HIGH_SCORE(10),SHAPES(7) Global HIGH_NAME$(),HIGH_SCORE(),SHAPES() Global LEVEL,SCORE,LEVEL_TIME,SPACES,PATH$,SHAPE,ROTATION,OUT_OF_TIME Global GAME_OVER,PLACE_MODE,OK,P1,P2,P3,P4,P5,P6,P7,P8,P9,CODE$,M_FLAG,C_FLAG Break Off : PATH$="SYS:" ' ' A_INITIALISATION B_MAIN_PROGRAM ' ' Procedure A_INITIALISATION CODE$="SHAPE" C_FLAG=False AA_READ_HIGH_SCORES AB_LOAD_AND_PACK_TITLE_SCREEN AC_LOAD_BOB_DATA AD_LOAD_MUSIC AE_LOAD_SAMPLES End Proc Procedure AA_READ_HIGH_SCORES If Exist(PATH$+"scores") Open In 1,PATH$+"scores" For I=1 To 10 Input #1,HIGH_NAME$(I),S$ HIGH_SCORE(I)=Val(S$) Next I Close 1 Else Restore HIGH_SCORE_DEFAULTS For I=1 To 10 Read HIGH_NAME$(I),HIGH_SCORE(I) Next I End If HIGH_SCORE_DEFAULTS: Data "BEATMASTER",500 Data "BEATMASTER",450 Data "BEATMASTER",400 Data "BEATMASTER",350 Data "BEATMASTER",300 Data "BEATMASTER",250 Data "BEATMASTER",200 Data "BEATMASTER",150 Data "BEATMASTER",100 Data "BEATMASTER",50 End Proc Procedure AB_LOAD_AND_PACK_TITLE_SCREEN Load Iff PATH$+"title.iff",0 Screen Hide 0 Curs Off : Flash Off : Hide Pack 0 To 6 End Proc Procedure AC_LOAD_BOB_DATA Load PATH$+"Bobs.ABK" End Proc Procedure AD_LOAD_MUSIC Load PATH$+"music.abk" Music 1 Tempo 17 M_FLAG=True End Proc Procedure AE_LOAD_SAMPLES Load PATH$+"samples.abk" End Proc Procedure B_MAIN_PROGRAM Repeat XA_RESTORE_SCREEN Pen 24 Paper 0 Print At(11,8);"F1 : PLAY GAME" Print At(11,10);"F2 : HIGH SCORES" Print At(11,12);"F3 : INSTRUCTIONS" Pen 21 Print At(11,16);" CODE: ";CODE$ Pen 9 Print At(11,24);" WRITTEN IN AMOS " If C_FLAG Pen 12 Print At(11,22);" CHEAT MODE ON " End If XD_DISPLAY_LEVEL XF_DISPLAY_SCORE XB_FADE_IN_PALETTE Repeat Repeat K$=Inkey$ Until K$<>"" K$=Upper$(K$) If(K$>="A") and(K$<="Z") CODE$=Right$(CODE$,4)+K$ Pen 21 Print At(20,16);CODE$ If CODE$="PENIS" C_FLAG=True End If If CODE$="FANNY" C_FLAG=False End If End If If C_FLAG Pen 12 Print At(11,22);" CHEAT MODE ON " Else Print At(11,22);" " End If S=Scancode If S=80 Then BA_PLAY_GAME If S=81 Then BB_HIGH_SCORES If S=82 Then BC_INSTRUCTIONS Until S=80 or S=81 or S=82 Repeat Until Inkey$="" Until False End Proc Procedure BA_PLAY_GAME XA_RESTORE_SCREEN BAA_INITIALISE_GAME Repeat BAB_INITIALISE_LEVEL XB_FADE_IN_PALETTE Limit Mouse X Hard(84),Y Hard(61) To X Hard(219),Y Hard(196) Timer=0 BAC_PLAY_LEVEL If Not GAME_OVER Then BAE_LEVEL_COMPLETE Until GAME_OVER If OUT_OF_TIME Then BAD_OUT_OF_TIME If SCORE>HIGH_SCORE(10) Then BAF_HIGH_SCORE End Proc Procedure BAA_INITIALISE_GAME GAME_OVER=False SCORE=0 LEVEL=1 XH_LEVEL_CODES["CHECK"] End Proc Procedure BAB_INITIALISE_LEVEL SPACES=0 SHAPE=1 ROTATION=1 PLACE_MODE=True OUT_OF_TIME=False Open Random 1,PATH$+"level-data" Field 1,333 As L$ Get 1,LEVEL Ink 0 Bob Off 1 Wait Vbl Bar 84,61 To 227,204 LEVEL_TIME=Asc(Left$(L$,1))*256+Asc(Mid$(L$,2,1)) Ink 0,30 For I=1 To 7 SHAPES(I)=Asc(Mid$(L$,2+I,1)) Text 16+33*I,250,Right$("0"+Str$(SHAPES(I))-" ",2) Next I Ink 6 For I=1 To 18 For J=1 To 18 X$=Mid$(L$,9+(I-1)*18+J,1) If X$="X" Then Bar 76+J*8,53+I*8 To 83+J*8,60+I*8 If X$=" " Then Inc SPACES Next J Next I Ink 21,5 XC_DISPLAY_TIME[LEVEL_TIME] XD_DISPLAY_LEVEL XE_DISPLAY_SPACES Close 1 End Proc Procedure BAC_PLAY_LEVEL FINISH=False Repeat X=X Screen(X Mouse) Y=Y Screen(Y Mouse) M=Mouse Click K$=Inkey$ If PLACE_MODE Bob 1,Int(X/8)*8-4,Int(Y/8)*8-3,SHAPE*8+4+ROTATION If M and 1 BACD_PUT_DOWN_PIECE[X,Y] End If If M and 2 Add ROTATION,1,1 To 4 End If Else Bob 1,Int(X/8)*8+7,Int(Y/8)*8+8,58 If M and 1 BACE_PICK_UP_PIECE[Int(X/8)*8+7,Int(Y/8)*8+8] End If End If If(M and 4) or(K$=" ") Then BACA_FLIP_MODE If(K$="m") or(K$="M") If M_FLAG Music Off M_FLAG=False Else Music 1 : Tempo 17 M_FLAG=True End If End If If K$=Chr$(27) Then GAME_OVER=True XC_DISPLAY_TIME[LEVEL_TIME-Timer/50] BACB_CHECK_FUNC_KEYS BACC_CHECK_TIMER If((K$="n") or(K$="N")) and C_FLAG Then SPACES=0 If SPACES=0 Then FINISH=True : LEVEL_TIME=LEVEL_TIME-Timer/50 Until FINISH or GAME_OVER End Proc Procedure BACA_FLIP_MODE If PLACE_MODE PLACE_MODE=False Ink 21,5 Text 22,201,"ERASE" Else PLACE_MODE=True Ink 21,5 Text 22,201,"PLACE" End If End Proc Procedure BACB_CHECK_FUNC_KEYS If Key State(80) Then SHAPE=0 If Key State(81) Then SHAPE=1 If Key State(82) Then SHAPE=2 If Key State(83) Then SHAPE=3 If Key State(84) Then SHAPE=4 If Key State(85) Then SHAPE=5 If Key State(86) Then SHAPE=6 End Proc Procedure BACC_CHECK_TIMER If Timer/50>LEVEL_TIME GAME_OVER=True OUT_OF_TIME=True End If End Proc Procedure BACD_PUT_DOWN_PIECE[X,Y] Bob Off 1 OK=True X=Int(X/8)*8-4 Y=Int(Y/8)*8-3 P1=(Point(X+3,Y+3)<>0) P2=(Point(X+11,Y+3)<>0) P3=(Point(X+19,Y+3)<>0) P4=(Point(X+3,Y+11)<>0) P5=(Point(X+11,Y+11)<>0) P6=(Point(X+19,Y+11)<>0) P7=(Point(X+3,Y+19)<>0) P8=(Point(X+11,Y+19)<>0) P9=(Point(X+19,Y+19)<>0) If SHAPE=0 Then BACDA_CHECK_SHAPE_0 If SHAPE=1 Then BACDB_CHECK_SHAPE_1 If SHAPE=2 Then BACDC_CHECK_SHAPE_2 If SHAPE=3 Then BACDD_CHECK_SHAPE_3 If SHAPE=4 Then BACDE_CHECK_SHAPE_4 If SHAPE=5 Then BACDF_CHECK_SHAPE_5 If SHAPE=6 Then BACDG_CHECK_SHAPE_6 If SHAPES(SHAPE+1)=0 Then OK=False : Sample 3 To 4 : Play 4,40,16 : Play 4,37,1 If OK Then BACDH_PASTE_SHAPE[X,Y] End Proc Procedure BACDA_CHECK_SHAPE_0 If P2 or P4 or P5 or P6 or P8 OK=False End If End Proc Procedure BACDB_CHECK_SHAPE_1 If ROTATION=1 and(P2 or P4 or P5 or P7) OK=False End If If ROTATION=2 and(P1 or P2 or P5 or P6) OK=False End If If ROTATION=3 and(P3 or P5 or P6 or P8) OK=False End If If ROTATION=4 and(P4 or P5 or P8 or P9) OK=False End If End Proc Procedure BACDC_CHECK_SHAPE_2 If ROTATION=1 and(P2 or P5 or P8 or P9) OK=False End If If ROTATION=2 and(P4 or P5 or P6 or P7) OK=False End If If ROTATION=3 and(P1 or P2 or P5 or P8) OK=False End If If ROTATION=4 and(P3 or P4 or P5 or P6) OK=False End If End Proc Procedure BACDD_CHECK_SHAPE_3 If ROTATION=1 and(P2 or P4 or P5 or P8) OK=False End If If ROTATION=2 and(P2 or P4 or P5 or P6) OK=False End If If ROTATION=3 and(P2 or P5 or P6 or P8) OK=False End If If ROTATION=4 and(P4 or P5 or P6 or P8) OK=False End If End Proc Procedure BACDE_CHECK_SHAPE_4 If ROTATION=1 and(P1 or P4 or P5 or P7 or P8) OK=False End If If ROTATION=2 and(P1 or P2 or P3 or P4 or P5) OK=False End If If ROTATION=3 and(P2 or P3 or P5 or P6 or P9) OK=False End If If ROTATION=4 and(P5 or P6 or P7 or P8 or P9) OK=False End If End Proc Procedure BACDF_CHECK_SHAPE_5 If ROTATION=1 and(P2 or P3 or P5 or P8 or P9) OK=False End If If ROTATION=2 and(P4 or P5 or P6 or P7 or P9) OK=False End If If ROTATION=3 and(P1 or P2 or P5 or P7 or P8) OK=False End If If ROTATION=4 and(P1 or P3 or P4 or P5 or P6) OK=False End If End Proc Procedure BACDG_CHECK_SHAPE_6 If(ROTATION=1 or ROTATION=3) and(P1 or P2 or P5 or P8 or P9) OK=False End If If(ROTATION=2 or ROTATION=4) and(P3 or P4 or P5 or P6 or P7) OK=False End If End Proc Procedure BACDH_PASTE_SHAPE[X,Y] Bob Off 1 Wait Vbl Paste Bob X,Y,SHAPE*8+ROTATION GX=(X-84)/8+1 GY=(X-61)/8+1 If SHAPE=0 Then SPACES=SPACES-5 : SCORE=SCORE+5 If SHAPE=1 Then SPACES=SPACES-4 : SCORE=SCORE+4 If SHAPE=2 Then SPACES=SPACES-4 : SCORE=SCORE+4 If SHAPE=3 Then SPACES=SPACES-4 : SCORE=SCORE+4 If SHAPE=4 Then SPACES=SPACES-5 : SCORE=SCORE+5 If SHAPE=5 Then SPACES=SPACES-5 : SCORE=SCORE+5 If SHAPE=6 Then SPACES=SPACES-5 : SCORE=SCORE+5 Dec SHAPES(SHAPE+1) XE_DISPLAY_SPACES XF_DISPLAY_SCORE XG_DISPLAY_SHAPE_COUNTS End Proc Procedure BACE_PICK_UP_PIECE[X,Y] Bob Off 1 Wait Vbl P=Point(X,Y) If P=9 Then BACEA_PICK_SHAPE_0[X,Y] If P=24 Then BACEB_PICK_SHAPE_1[X,Y] If P=21 Then BACEC_PICK_SHAPE_2[X,Y] If P=15 Then BACED_PICK_SHAPE_3[X,Y] If P=18 Then BACEE_PICK_SHAPE_4[X,Y] If P=27 Then BACEF_PICK_SHAPE_5[X,Y] If P=12 Then BACEG_PICK_SHAPE_6[X,Y] XE_DISPLAY_SPACES XF_DISPLAY_SCORE XG_DISPLAY_SHAPE_COUNTS End Proc Procedure BACEA_PICK_SHAPE_0[X,Y] If Point(X-3,Y)=9 and Point(X+4,Y)<>9 Then X=X-8 If Point(X+4,Y)=9 and Point(X-3,Y)<>9 Then X=X+8 If Point(X,Y-3)=9 and Point(X,Y+4)<>9 Then Y=Y-8 If Point(X,Y+4)=9 and Point(X,Y-3)<>9 Then Y=Y+8 X=X-11 Y=Y-11 Ink 0 Bar X+8,Y To X+15,Y+23 Bar X,Y+8 To X+23,Y+15 SPACES=SPACES+5 SCORE=SCORE-5 Inc SHAPES(1) End Proc Procedure BACEB_PICK_SHAPE_1[X,Y] P1=(Point(X-3,Y)=24) : N1=(Point(X-3,Y)<>24) P2=(Point(X,Y-3)=24) : N2=(Point(X,Y-3)<>24) P3=(Point(X+4,Y)=24) : N3=(Point(X+4,Y)<>24) P4=(Point(X,Y+4)=24) : N4=(Point(X,Y+4)<>24) If N1 and N2 and N3 and P4 Then R=1 : Y=Y+8 If P1 and P2 and N3 and N4 Then R=1 If N1 and N2 and P3 and P4 Then R=1 : X=X+8 If N1 and P2 and N3 and N4 Then R=1 : X=X+8 : Y=Y-8 If N1 and N2 and P3 and N4 Then R=2 : X=X+8 : Y=Y+8 If P1 and N2 and N3 and P4 Then R=2 : Y=Y+8 If N1 and P2 and P3 and N4 Then R=2 If P1 and N2 and N3 and N4 Then R=2 : X=X-8 X=X-11 : Y=Y-11 Ink 0 If R=1 Bar X+8,Y To X+15,Y+15 Bar X,Y+8 To X+7,Y+23 End If If R=2 Bar X,Y To X+15,Y+7 Bar X+8,Y+8 To X+23,Y+15 End If SPACES=SPACES+4 SCORE=SCORE-4 Inc SHAPES(2) End Proc Procedure BACEC_PICK_SHAPE_2[X,Y] BACEC_RECHECK: P1=(Point(X-3,Y)=21) : N1=(Point(X-3,Y)<>21) P2=(Point(X,Y-3)=21) : N2=(Point(X,Y-3)<>21) P3=(Point(X+4,Y)=21) : N3=(Point(X+4,Y)<>21) P4=(Point(X,Y+4)=21) : N4=(Point(X,Y+4)<>21) P5=(Point(X-11,Y+3)=21) : N5=(Point(X-11,Y+3)<>21) P6=(Point(X+3,Y-11)=21) : N6=(Point(X+3,Y-11)<>21) P7=(Point(X+12,Y+3)=21) : N7=(Point(X+12,Y+3)<>21) P8=(Point(X+3,Y+12)=21) : N8=(Point(X+3,Y+12)<>21) If N1 and N2 and N3 and P4 and P8 Then R=1 : Y=Y+8 If N1 and P2 and N3 and P4 Then Y=Y-8 : Goto BACEC_RECHECK If N1 and P2 and P3 and N4 Then R=1 : Y=Y-8 If P1 and N2 and N3 and N4 and N5 Then R=1 : Y=Y-8 : X=X-8 If N1 and N2 and P3 and P4 Then R=2 : X=X+8 If P1 and N2 and P3 and N4 Then X=X-8 : Goto BACEC_RECHECK If P1 and N2 and N3 and N4 and P5 Then R=2 : X=X-8 If N1 and P2 and N3 and N4 and N6 Then R=2 : X=X+8 : Y=Y-8 If N1 and N2 and P3 and N4 and N7 Then R=3 : X=X+8 : Y=Y+8 If P1 and N2 and N3 and P4 Then R=3 : Y=Y+8 If N1 and P2 and N3 and N4 and P6 Then R=3 : Y=Y-8 If N1 and N2 and N3 and P4 and N8 Then R=4 : Y=Y+8 : X=X-8 If N1 and N2 and P3 and N4 and P7 Then R=4 : X=X+8 If P1 and P2 and N3 and N4 Then R=4 : X=X-8 X=X-11 : Y=Y-11 Ink 0 If R=1 Bar X+8,Y To X+15,Y+23 Bar X+16,Y+16 To X+23,Y+23 End If If R=2 Bar X,Y+8 To X+23,Y+15 Bar X,Y+16 To X+7,Y+23 End If If R=3 Bar X,Y To X+15,Y+7 Bar X+8,Y To X+15,Y+23 End If If R=4 Bar X+16,Y To X+23,Y+7 Bar X,Y+8 To X+23,Y+15 End If SPACES=SPACES+4 SCORE=SCORE-4 Inc SHAPES(3) End Proc Procedure BACED_PICK_SHAPE_3[X,Y] BACED_RECHECK: P1=(Point(X-3,Y)=15) : N1=(Point(X-3,Y)<>15) P2=(Point(X,Y-3)=15) : N2=(Point(X,Y-3)<>15) P3=(Point(X+4,Y)=15) : N3=(Point(X+4,Y)<>15) P4=(Point(X,Y+4)=15) : N4=(Point(X,Y+4)<>15) If N1 and N2 and N3 and P4 Then Y=Y+8 : Goto BACED_RECHECK If N1 and N2 and P3 and N4 Then X=X+8 : Goto BACED_RECHECK If P1 and N2 and N3 and N4 Then X=X-8 : Goto BACED_RECHECK If N1 and P2 and N3 and N4 Then Y=Y-8 : Goto BACED_RECHECK If P1 and P2 and N3 and P4 Then R=1 If P1 and P2 and P3 and N4 Then R=2 If N1 and P2 and P3 and P4 Then R=3 If P1 and N2 and P3 and P4 Then R=4 Ink 0 X=X-11 : Y=Y-11 Bar X+8,Y+8 To X+15,Y+15 If R=1 or R=2 or R=4 Then Bar X,Y+8 To X+7,Y+15 If R=1 or R=2 or R=3 Then Bar X+8,Y To X+15,Y+8 If R=2 or R=3 or R=4 Then Bar X+16,Y+8 To X+23,Y+15 If R=1 or R=3 or R=4 Then Bar X+8,Y+16 To X+15,Y+23 SPACES=SPACES+4 SCORE=SCORE-4 Inc SHAPES(4) End Proc Procedure BACEE_PICK_SHAPE_4[X,Y] BACEE_RECHECK: P1=(Point(X-3,Y)=18) : N1=(Point(X-3,Y)<>18) P2=(Point(X,Y-3)=18) : N2=(Point(X,Y-3)<>18) P3=(Point(X+4,Y)=18) : N3=(Point(X+4,Y)<>18) P4=(Point(X,Y+4)=18) : N4=(Point(X,Y+4)<>18) If N1 and N2 and P3 and P4 Then X=X+8 : Goto BACEE_RECHECK If P1 and N2 and N3 and P4 Then Y=Y+8 : Goto BACEE_RECHECK If P1 and P2 and N3 and N4 Then X=X-8 : Goto BACEE_RECHECK If N1 and P2 and P3 and N4 Then Y=Y-8 : Goto BACEE_RECHECK If N1 and N2 and N3 and P4 Then R=1 : X=X+8 : Y=Y+8 If P1 and N2 and N3 and N4 Then R=2 : X=X-8 : Y=Y+8 If N1 and P2 and N3 and N4 Then R=3 : X=X-8 : Y=Y-8 If N1 and N2 and P3 and N4 Then R=4 : X=X+8 : Y=Y-8 If N1 and P2 and P3 and P4 Then R=1 : X=X+8 If P1 and N2 and P3 and P4 Then R=2 : Y=Y+8 If P1 and P2 and N3 and P4 Then R=3 : X=X-8 If P1 and P2 and P3 and N4 Then R=4 : Y=Y-8 X=X-11 : Y=Y-11 Ink 0 If R=1 Bar X,Y To X+7,Y+7 Bar X,Y+8 To X+15,Y+23 End If If R=2 Bar X,Y To X+15,Y+15 Bar X+16,Y To X+23,Y+7 End If If R=3 Bar X+8,Y To X+23,Y+15 Bar X+16,Y+16 To X+23,Y+23 End If If R=4 Bar X,Y+16 To X+7,Y+23 Bar X+8,Y+8 To X+23,Y+23 End If SPACES=SPACES+5 SCORE=SCORE-5 Inc SHAPES(5) End Proc Procedure BACEF_PICK_SHAPE_5[X,Y] BACEF_RECHECK: P1=(Point(X-3,Y)=27) : N1=(Point(X-3,Y)<>27) P2=(Point(X,Y-3)=27) : N2=(Point(X,Y-3)<>27) P3=(Point(X+4,Y)=27) : N3=(Point(X+4,Y)<>27) P4=(Point(X,Y+4)=27) : N4=(Point(X,Y+4)<>27) XX=X : YY=Y If N1 and N2 and P3 and P4 and Point(XX,YY+12)=27 Then R=1 : Y=Y+8 If N1 and P2 and N3 and P4 and Point(XX-3,YY+8)<>27 Then R=1 If N1 and P2 and P3 and N4 and Point(XX,YY-11)=27 Then R=1 : Y=Y-8 If P1 and N2 and N3 and N4 and Point(XX-8,YY-3)<>27 Then R=1 : X=X-8 : Y=Y+8 If P1 and N2 and N3 and N4 and Point(XX-8,YY-3)=27 Then R=1 : X=X-8 : Y=Y-8 If N1 and N2 and P3 and P4 and Point(XX,YY+12)<>27 Then R=2 : X=X+8 If P1 and N2 and P3 and N4 and Point(XX+8,YY-3)<>27 Then R=2 If P1 and N2 and N3 and P4 and Point(XX-11,YY)=27 Then R=2 : X=X-8 If N1 and P2 and N3 and N4 and Point(XX-3,YY-8)<>27 Then R=2 : X=X+8 : Y=Y-8 If N1 and P2 and N3 and N4 and Point(XX-3,YY-8)=27 Then R=2 : X=X-8 : Y=Y-8 If N1 and N2 and P3 and N4 and Point(XX+8,YY-3)<>27 Then R=3 : X=X+8 : Y=Y+8 If N1 and N2 and P3 and N4 and Point(XX+8,YY-3)=27 Then R=3 : X=X+8 : Y=Y-8 If P1 and N2 and N3 and P4 and Point(XX,YY+12)=27 Then R=3 : Y=Y+8 If N1 and P2 and N3 and P4 and Point(XX-3,YY+8)=27 Then R=3 If P1 and P2 and N3 and N4 and Point(XX-11,YY)<>27 Then R=3 : Y=Y-8 If N1 and N2 and N3 and P4 and Point(XX+4,YY+8)=27 Then R=4 : X=X+8 : Y=Y+8 If N1 and N2 and N3 and P4 and Point(XX+4,YY+8)<>27 Then R=4 : X=X-8 : Y=Y+8 If N1 and P2 and P3 and N4 and Point(XX,YY-11)<>27 Then R=4 : X=X+8 If P1 and N2 and P3 and N4 and Point(XX+8,YY-3)=27 Then R=4 If P1 and P2 and N3 and N4 and Point(XX-11,YY)=27 Then R=4 : X=X-8 X=X-11 : Y=Y-11 Ink 0 If R=1 or R=3 Then Bar X+8,Y To X+15,Y+23 If R=2 or R=4 Then Bar X,Y+8 To X+23,Y+15 If R=3 or R=4 Then Bar X,Y To X+7,Y+7 If R=1 or R=4 Then Bar X+16,Y To X+23,Y+7 If R=1 or R=2 Then Bar X+16,Y+16 To X+23,Y+23 If R=2 or R=3 Then Bar X,Y+16 To X+7,Y+23 SPACES=SPACES+5 SCORE=SCORE-5 Inc SHAPES(6) End Proc Procedure BACEG_PICK_SHAPE_6[X,Y] P1=(Point(X-3,Y)=12) : N1=(Point(X-3,Y)<>12) P2=(Point(X,Y-3)=12) : N2=(Point(X,Y-3)<>12) P3=(Point(X+4,Y)=12) : N3=(Point(X+4,Y)<>12) P4=(Point(X,Y+4)=12) : N4=(Point(X,Y+4)<>12) If N1 and N2 and P3 and N4 Then R=1 : X=X+8 : Y=Y+8 If P1 and N2 and N3 and P4 Then R=1 : Y=Y+8 If N1 and P2 and N3 and P4 Then R=1 If N1 and P2 and P3 and N4 Then R=1 : Y=Y-8 If P1 and N2 and N3 and N4 Then R=1 : X=X-8 : Y=Y-8 If N1 and N2 and N3 and P4 Then R=2 : X=X-8 : Y=Y+8 If N1 and N2 and P3 and P4 Then R=2 : X=X+8 If P1 and N2 and P3 and N4 Then R=2 If P1 and P2 and N3 and N4 Then R=2 : X=X-8 If N1 and P2 and N3 and N4 Then R=2 : X=X+8 : Y=Y-8 X=X-11 : Y=Y-11 Ink 0 Bar X+8,Y+8 To X+15,Y+15 If R=1 Bar X,Y To X+15,Y+7 Bar X+8,Y+16 To X+23,Y+23 End If If R=2 Bar X,Y+8 To X+7,Y+23 Bar X+16,Y To X+23,Y+15 End If SPACES=SPACES+5 SCORE=SCORE-5 Inc SHAPES(7) End Proc Procedure BAD_OUT_OF_TIME Ink 8 Bar 105,124 To 206,139 Pen 31 : Paper 8 Print At(14,16);"OUT OF TIME" Ink 10 Box 105,124 To 206,139 Box 107,126 To 204,137 Sample 1 To 4 Play 4,40,50 XH_WAIT End Proc Procedure BAE_LEVEL_COMPLETE If M_FLAG Then Mvolume 0 Sample 2 To 4 Play 4,40,63 If M_FLAG Then Mvolume 63 For I=LEVEL_TIME To 0 Step -1 Inc SCORE Wait Vbl Wait Vbl Wait Vbl XC_DISPLAY_TIME[I] XF_DISPLAY_SCORE Next I LEVEL=LEVEL+1 If LEVEL<=50 Ink 0 Bar 84,61 To 227,204 Pen 21 Print At(12,12);"LEVEL COMPLETE!" Print At(11,16);"CODE FOR LEVEL";Str$(LEVEL) Pen 24 XH_LEVEL_CODES["SET"] Print At(17,18);CODE$ XH_WAIT Fade 2,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 Else GAME_OVER=True BAEE_ADD_LEVEL_BONUS End If End Proc Procedure BAEE_ADD_LEVEL_BONUS Ink 0 Bar 84,61 To 227,204 Pen 21 Print At(11,12);"CONGRATULATIONS!!" Print At(11,14);"YOU HAVE FINISHED" Print At(11,16);" THE GAME!!! " XH_WAIT End Proc Procedure BAF_HIGH_SCORE XA_RESTORE_SCREEN XD_DISPLAY_LEVEL XF_DISPLAY_SCORE P=10 For I=10 To 1 Step -1 If SCORE>HIGH_SCORE(I) Then P=I Next I For I=10 To P+1 Step -1 HIGH_NAME$(I)=HIGH_NAME$(I-1) HIGH_SCORE(I)=HIGH_SCORE(I-1) Next I HIGH_SCORE(P)=SCORE HIGH_NAME$(P)="??????????" Paper 0 For I=1 To 10 If I=P Then Pen 27 Else Pen 21 Print At(11,9+I);HIGH_NAME$(I);" ";Right$(("00000"+(Str$(HIGH_SCORE(I))-" ")),5); Next I Pen 18 Print At(11,8);" HIGH SCORES " Pen 12 Print At(11,21);" WELL DONE!! " Print At(11,22);" ENTER YOUR NAME " Print At(11,24);" [ ]" XB_FADE_IN_PALETTE N$="" Pen 24 Repeat Print At(14,24);Left$(N$+" ",10) K$=Upper$(Inkey$) If Instr("ABCDEFGHIJKLMNOPQRSTUVWXYZ !@#$%^&*()-=+.,:;?/`'",K$) If Len(N$)<10 N$=N$+K$ Else N$=Right$(N$,9)+K$ End If End If Until K$=Chr$(13) HIGH_NAME$(P)=Left$(N$+" ",10) Open Out 1,PATH$+"scores" For I=1 To 10 Print #1,HIGH_NAME$(I) Print #1,(Str$(HIGH_SCORE(I))-" ") Next I Close 1 BB_HIGH_SCORES End Proc Procedure XH_LEVEL_CODES[M$] If M$="SET" Restore CODES For I=1 To LEVEL Read CODE$ Next I End If If M$="CHECK" Restore CODES LEVEL=1 Read C$ While(C$<>CODE$) and(C$<>"*") Inc LEVEL Read C$ Wend If C$="*" LEVEL=1 End If End If CODES: Data "SHAPE","AMIGA","MOUSE","TANGO","CUBIK" Data "XENON","QUEEN","APRIL","TASTE","PENNY" Data "TRUTH","POWER","TURBO","MUSIC","MATEY" Data "SOUND","WORLD","STYLE","VIRUS","PRINT" Data "MILKY","KNOCK","BRAIN","GAZZA","ISSUE" Data "MATCH","SMURF","PRIZE","TEDDY","GROUP" Data "DIANE","SMALL","UNITE","PAINT","VIDEO" Data "STILL","INPUT","OFFER","FIRST","ORION" Data "PIANO","SHARE","OASIS","KINKY","MORPH" Data "NINJA","STONE","GREEN","OZONE","CHIPS" Data "*" End Proc Procedure BB_HIGH_SCORES XA_RESTORE_SCREEN Paper 0 Pen 21 For I=1 To 10 Print At(11,9+I);HIGH_NAME$(I);" ";Right$(("00000"+(Str$(HIGH_SCORE(I))-" ")),5); Next I Pen 18 Print At(11,8);" HIGH SCORES " Pen 12 Print At(11,23);"PRESS ANY KEY TO" Print At(11,24);" RETURN TO MENU " XB_FADE_IN_PALETTE Repeat : Until Inkey$="" Repeat : Until Inkey$<>"" End Proc Procedure BC_INSTRUCTIONS BCA_SCREEN_MASK Print At(11,10);"THE OBJECT OF THE" Print At(11,11);" GAME IS TO FILL " Print At(11,12);"THE BLACK AREA OF" Print At(11,13);" THE BOARD USING " Print At(11,14);"THE SHAPES AT THE" Print At(11,15);" BOTTOM OF THE " Print At(11,16);" SCREEN. " Print At(11,18);"HOWEVER, YOU ONLY" Print At(11,19);" HAVE SO MANY OF " Print At(11,20);"EACH SHAPE TO USE" Print At(11,21);" AS INDICATED BY " Print At(11,22);" THE VALUE BELOW " Print At(11,23);" THE SHAPES. " XB_FADE_IN_PALETTE XH_WAIT BCA_SCREEN_MASK Print At(11,10);" TO PUT DOWN A " Print At(11,11);"SHAPE SIMPLY MOVE" Print At(11,12);"TO WHERE YOU WANT" Print At(11,13);"IT WITH THE MOUSE" Print At(11,14);" AND CLICK THE " Print At(11,15);"LEFT MOUSE BUTTON" Print At(11,17);" THE RIGHT MOUSE " Print At(11,18);" BUTTON WILL " Print At(11,19);"ROTATE THE SHAPE." Print At(11,21);"TO SELECT ANOTHER" Print At(11,22);" SHAPE PRESS THE " Print At(11,23);" FUNCTION KEY OF " Print At(11,24);" THAT SHAPES NO. " XB_FADE_IN_PALETTE XH_WAIT BCA_SCREEN_MASK Print At(11,10);" PRESSING THE " Print At(11,11);"SPACE BAR (OR THE" Print At(11,12);"MIDDLE BUTTON ON " Print At(11,13);"SOME MOUSES) WILL" Print At(11,14);" TOGGLE YOU INTO " Print At(11,15);" ERASE MODE. " Print At(11,17);"IN THIS MODE JUST" Print At(11,18);" CLICK ON ANY OF " Print At(11,19);"THE SHAPES ON THE" Print At(11,20);"BOARD AND IT WILL" Print At(11,21);" BE REMOVED FROM " Print At(11,22);" THE BOARD. " XB_FADE_IN_PALETTE XH_WAIT BCA_SCREEN_MASK Print At(11,10);"WHEN YOU COMPLETE" Print At(11,11);"EACH LEVEL A CODE" Print At(11,12);"WILL BE GIVEN FOR" Print At(11,13);" THE NEXT LEVEL. " Print At(11,14);"ENTERING THE CODE" Print At(11,15);" ON THE TITLE- " Print At(11,16);"SCREEN WILL ALLOW" Print At(11,17);"YOU TO START THE " Print At(11,18);" GAME AT THAT " Print At(11,19);" LEVEL. " XB_FADE_IN_PALETTE XH_WAIT BCA_SCREEN_MASK Print At(11,10);"PRESSING `M' WILL" Print At(11,11);"TURN THE MUSIC ON" Print At(11,12);" OR OFF." Print At(11,14);" `ESC' WILL EXIT " Print At(11,15);"THE CURRENT GAME." XB_FADE_IN_PALETTE XH_WAIT BCA_SCREEN_MASK Print At(11,10);"THIS GAME IS DISK" Print At(11,11);"WARE. DISKWARE IS" Print At(11,12);" LIKE SHAREWARE, " Print At(11,13);" BUT INSTEAD OF " Print At(11,14);"SENDING MONEY YOU" Print At(11,15);"MUST SEND A DISK " Print At(11,16);"CONTAINING A P.D." Print At(11,17);" PROGRAM TO THE " Print At(11,18);" AUTHOR. " Print At(11,20);"ALLOWING FOR THE " Print At(11,21);"PRICE OF POSTAGE " Print At(11,22);" THATS ABOUT 70P " Print At(11,23);"FOR A FULL GAME!!" XB_FADE_IN_PALETTE XH_WAIT BCA_SCREEN_MASK Print At(11,10);"SEND DONATIONS TO" Print At(11,12);"MIKE ARCHER" Print At(11,13);"29 HOLBECK AVE" Print At(11,14);"MARTON" Print At(11,15);"BLACKPOOL" Print At(11,16);"FY4 4LS" Print At(11,18);" IF I DO NOT GET " Print At(11,19);" A GOOD RESPONSE " Print At(11,20);"THEN FUTURE GAMES" Print At(11,21);" WILL BE MADE " Print At(11,22);" LICENSEWARE. " Pen 24 Print At(11,24);" (SO BE HONEST!) " XB_FADE_IN_PALETTE XH_WAIT End Proc Procedure BCA_SCREEN_MASK XA_RESTORE_SCREEN Pen 9 Print At(11,8);"GAME INSTRUCTIONS" Pen 21 End Proc Procedure XA_RESTORE_SCREEN Fade 2,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 Wait 30 Unpack 6 Screen Show 0 : Rem This is just incase screen isn't showing already End Proc Procedure XB_FADE_IN_PALETTE Fade 2,$0,$F00,$F77,$FFF,$C6F,$333,$555,$777,$809,$F0F,$F7F,$A,$F,$78F,$B60,$F80,$FA4,$88,$DD,$AFF,$90,$F0,$AFA,$800,$F00,$F77,$870,$CC0,$FF7,$999,$CCC,$FFF Wait 30 Shift Up 5,1,3,1 End Proc Procedure XC_DISPLAY_TIME[T] Ink 21,5 : If T<0 Then T=0 Text 28,141,Str$(T/60)-" " Text 40,141,Right$("00"+Str$(T mod 60)-" ",2) End Proc Procedure XD_DISPLAY_LEVEL Ink 21,5 Text 30,111,Right$(("00"+Str$(LEVEL)-" "),3) End Proc Procedure XE_DISPLAY_SPACES Ink 21,5 Text 30,171,Right$(("00"+Str$(SPACES)-" "),3) End Proc Procedure XF_DISPLAY_SCORE Ink 21,5 Text 21,81,Right$("0000"+Str$(SCORE)-" ",5) End Proc Procedure XG_DISPLAY_SHAPE_COUNTS Ink 0,30 For I=1 To 7 Text 16+33*I,250,Right$("0"+Str$(SHAPES(I))-" ",2) Next I End Proc Procedure XH_WAIT Repeat : Until(Inkey$="") and(Mouse Click=0) Repeat : Until(Inkey$<>"") or(Mouse Click<>0) End Proc